home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database Designers / Rational Rose 2000 / Rational Setup.EXE / common / lib / Win32 / Internet.pm < prev    next >
Encoding:
Perl POD Document  |  1998-11-15  |  38.5 KB  |  1,380 lines
  1. #######################################################################
  2. #
  3. # Win32::Internet - Perl Module for Internet Extensions
  4. # ^^^^^^^^^^^^^^^
  5. # This module creates an object oriented interface to the Win32
  6. # Internet Functions (WININET.DLL).
  7. #
  8. # Version: 0.08 (14 Feb 1997)
  9. #
  10. #######################################################################
  11.  
  12. # changes:
  13. # - fixed 2 bugs in Option(s) related subs
  14. # - works with build 30x also
  15.  
  16. package Win32::Internet;
  17.  
  18. require Exporter;       # to export the constants to the main:: space
  19. require DynaLoader;     # to dynuhlode the module.
  20.  
  21. # use Win32::WinError;    # for windows constants.
  22.  
  23. @ISA= qw( Exporter DynaLoader );
  24. @EXPORT = qw(
  25.     HTTP_ADDREQ_FLAG_ADD
  26.     HTTP_ADDREQ_FLAG_REPLACE
  27.     HTTP_QUERY_ALLOW
  28.     HTTP_QUERY_CONTENT_DESCRIPTION
  29.     HTTP_QUERY_CONTENT_ID
  30.     HTTP_QUERY_CONTENT_LENGTH
  31.     HTTP_QUERY_CONTENT_TRANSFER_ENCODING
  32.     HTTP_QUERY_CONTENT_TYPE
  33.     HTTP_QUERY_COST
  34.     HTTP_QUERY_CUSTOM
  35.     HTTP_QUERY_DATE
  36.     HTTP_QUERY_DERIVED_FROM
  37.     HTTP_QUERY_EXPIRES
  38.     HTTP_QUERY_FLAG_REQUEST_HEADERS
  39.     HTTP_QUERY_FLAG_SYSTEMTIME
  40.     HTTP_QUERY_LANGUAGE
  41.     HTTP_QUERY_LAST_MODIFIED
  42.     HTTP_QUERY_MESSAGE_ID
  43.     HTTP_QUERY_MIME_VERSION
  44.     HTTP_QUERY_PRAGMA
  45.     HTTP_QUERY_PUBLIC
  46.     HTTP_QUERY_RAW_HEADERS
  47.     HTTP_QUERY_RAW_HEADERS_CRLF
  48.     HTTP_QUERY_REQUEST_METHOD
  49.     HTTP_QUERY_SERVER
  50.     HTTP_QUERY_STATUS_CODE
  51.     HTTP_QUERY_STATUS_TEXT
  52.     HTTP_QUERY_URI
  53.     HTTP_QUERY_USER_AGENT
  54.     HTTP_QUERY_VERSION
  55.     HTTP_QUERY_WWW_LINK
  56.     ICU_BROWSER_MODE
  57.     ICU_DECODE
  58.     ICU_ENCODE_SPACES_ONLY
  59.     ICU_ESCAPE
  60.     ICU_NO_ENCODE
  61.     ICU_NO_META
  62.     ICU_USERNAME
  63.     INTERNET_CONNECT_FLAG_PASSIVE
  64.     INTERNET_FLAG_ASYNC
  65.     INTERNET_HYPERLINK
  66.     INTERNET_FLAG_KEEP_CONNECTION
  67.     INTERNET_FLAG_MAKE_PERSISTENT
  68.     INTERNET_FLAG_NO_AUTH
  69.     INTERNET_FLAG_NO_AUTO_REDIRECT
  70.     INTERNET_FLAG_NO_CACHE_WRITE
  71.     INTERNET_FLAG_NO_COOKIES
  72.     INTERNET_FLAG_READ_PREFETCH
  73.     INTERNET_FLAG_RELOAD
  74.     INTERNET_FLAG_RESYNCHRONIZE
  75.     INTERNET_FLAG_TRANSFER_ASCII
  76.     INTERNET_FLAG_TRANSFER_BINARY
  77.     INTERNET_INVALID_PORT_NUMBER
  78.     INTERNET_INVALID_STATUS_CALLBACK
  79.     INTERNET_OPEN_TYPE_DIRECT
  80.     INTERNET_OPEN_TYPE_PROXY
  81.     INTERNET_OPEN_TYPE_PROXY_PRECONFIG
  82.     INTERNET_OPTION_CONNECT_BACKOFF
  83.     INTERNET_OPTION_CONNECT_RETRIES
  84.     INTERNET_OPTION_CONNECT_TIMEOUT
  85.     INTERNET_OPTION_CONTROL_SEND_TIMEOUT
  86.     INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT
  87.     INTERNET_OPTION_DATA_SEND_TIMEOUT
  88.     INTERNET_OPTION_DATA_RECEIVE_TIMEOUT
  89.     INTERNET_OPTION_HANDLE_SIZE
  90.     INTERNET_OPTION_LISTEN_TIMEOUT
  91.     INTERNET_OPTION_PASSWORD
  92.     INTERNET_OPTION_READ_BUFFER_SIZE
  93.     INTERNET_OPTION_USER_AGENT
  94.     INTERNET_OPTION_USERNAME
  95.     INTERNET_OPTION_VERSION
  96.     INTERNET_OPTION_WRITE_BUFFER_SIZE
  97.     INTERNET_SERVICE_FTP
  98.     INTERNET_SERVICE_GOPHER
  99.     INTERNET_SERVICE_HTTP
  100.     INTERNET_STATUS_CLOSING_CONNECTION
  101.     INTERNET_STATUS_CONNECTED_TO_SERVER    
  102.     INTERNET_STATUS_CONNECTING_TO_SERVER
  103.     INTERNET_STATUS_CONNECTION_CLOSED
  104.     INTERNET_STATUS_HANDLE_CLOSING
  105.     INTERNET_STATUS_HANDLE_CREATED
  106.     INTERNET_STATUS_NAME_RESOLVED
  107.     INTERNET_STATUS_RECEIVING_RESPONSE
  108.     INTERNET_STATUS_REDIRECT    
  109.     INTERNET_STATUS_REQUEST_COMPLETE    
  110.     INTERNET_STATUS_REQUEST_SENT    
  111.     INTERNET_STATUS_RESOLVING_NAME    
  112.     INTERNET_STATUS_RESPONSE_RECEIVED
  113.     INTERNET_STATUS_SENDING_REQUEST    
  114. );
  115.  
  116.  
  117. #######################################################################
  118. # This AUTOLOAD is used to 'autoload' constants from the constant()
  119. # XS function.  If a constant is not found then control is passed
  120. # to the AUTOLOAD in AutoLoader.
  121. #
  122.  
  123. sub AUTOLOAD {
  124.     my($constname);
  125.     ($constname = $AUTOLOAD) =~ s/.*:://;
  126.     #reset $! to zero to reset any current errors.
  127.     $!=0;
  128.     my $val = constant($constname, @_ ? $_[0] : 0);
  129.     if ($! != 0) {
  130.  
  131.         # [dada] This results in an ugly Autoloader error
  132.         #if ($! =~ /Invalid/) {
  133.         #  $AutoLoader::AUTOLOAD = $AUTOLOAD;
  134.         #  goto &AutoLoader::AUTOLOAD;
  135.         #} else {
  136.       
  137.         # [dada] ... I prefer this one :)
  138.   
  139.             ($pack,$file,$line) = caller; undef $pack;
  140.             die "Win32::Internet::$constname is not defined, used at $file line $line.";
  141.   
  142.         #}
  143.     }
  144.     eval "sub $AUTOLOAD { $val }";
  145.     goto &$AUTOLOAD;
  146. }
  147.  
  148.  
  149. #######################################################################
  150. # STATIC OBJECT PROPERTIES
  151. #
  152. $VERSION = "0.08";
  153.  
  154. %callback_code = ();
  155. %callback_info = ();
  156.  
  157.  
  158. #######################################################################
  159. # PUBLIC METHODS
  160. #
  161.  
  162. #======== ### CLASS CONSTRUCTOR
  163. sub new {
  164. #========
  165.     my($class, $useragent, $opentype, $proxy, $proxybypass, $flags) = @_;
  166.     my $self = {};  
  167.  
  168.     if(ref($useragent) and ref($useragent) eq "HASH") {
  169.         $opentype       = $useragent->{'opentype'};
  170.         $proxy          = $useragent->{'proxy'};
  171.         $proxybypass    = $useragent->{'proxybypass'};
  172.         $flags          = $useragent->{'flags'};
  173.         my $myuseragent = $useragent->{'useragent'};
  174.         undef $useragent;
  175.         $useragent      = $myuseragent;
  176.     }
  177.  
  178.     $useragent = "Perl-Win32::Internet/".$VERSION       unless defined($useragent);
  179.     $opentype = constant("INTERNET_OPEN_TYPE_DIRECT",0) unless defined($opentype);
  180.     $proxy = ""                                         unless defined($proxy);
  181.     $proxybypass = ""                                   unless defined($proxybypass);
  182.     $flags = 0                                          unless defined($flags);
  183.  
  184.  
  185.     my $handle = InternetOpen($useragent, $opentype, $proxy, $proxybypass, $flags);
  186.     if ($handle) {
  187.         $self->{'connections'} = 0;
  188.         $self->{'pasv'}        = 0;
  189.         $self->{'handle'}      = $handle; 
  190.         $self->{'useragent'}   = $useragent;
  191.         $self->{'proxy'}       = $proxy;
  192.         $self->{'proxybypass'} = $proxybypass;
  193.         $self->{'flags'}       = $flags;
  194.         $self->{'Type'}        = "Internet";
  195.     
  196.         # [dada] I think it's better to call SetStatusCallback explicitly...
  197.         #if($flags & constant("INTERNET_FLAG_ASYNC",0)) {
  198.         #  my $callbackresult=InternetSetStatusCallback($handle);
  199.         #  if($callbackresult==&constant("INTERNET_INVALID_STATUS_CALLBACK",0)) {
  200.         #    $self->{'Error'} = -2;
  201.         #  }
  202.         #}
  203.  
  204.         bless $self;
  205.     } else {
  206.         $self->{'handle'} = undef;
  207.         bless $self;
  208.     }
  209.     $self;
  210. }  
  211.  
  212.  
  213. #============
  214. sub OpenURL {
  215. #============
  216.     my($self,$new,$URL) = @_;
  217.     return undef unless ref($self);
  218.  
  219.     my $newhandle=InternetOpenUrl($self->{'handle'},$URL,"",0,0,0);
  220.     if(!$newhandle) {
  221.         $self->{'Error'} = "Cannot open URL.";
  222.         return undef;
  223.     } else {
  224.         $self->{'connections'}++;
  225.         $_[1] = _new($newhandle);
  226.         $_[1]->{'Type'} = "URL";
  227.         $_[1]->{'URL'}  = $URL;
  228.         return $newhandle;
  229.     }
  230. }
  231.  
  232.  
  233. #================
  234. sub TimeConvert {
  235. #================
  236.     my($self, $sec, $min, $hour, $day, $mon, $year, $wday, $rfc) = @_;
  237.     return undef unless ref($self);
  238.  
  239.     if(!defined($rfc)) {
  240.         return InternetTimeToSystemTime($sec);
  241.     } else {
  242.         return InternetTimeFromSystemTime($sec, $min, $hour, 
  243.                                           $day, $mon, $year, 
  244.                                           $wday, $rfc);
  245.     }
  246. }
  247.  
  248.  
  249. #=======================
  250. sub QueryDataAvailable {
  251. #=======================
  252.     my($self) = @_;
  253.     return undef unless ref($self);
  254.   
  255.     return InternetQueryDataAvailable($self->{'handle'});
  256. }
  257.  
  258.  
  259. #=============
  260. sub ReadFile {
  261. #=============
  262.     my($self, $buffersize) = @_;
  263.     return undef unless ref($self);
  264.  
  265.     my $howmuch = InternetQueryDataAvailable($self->{'handle'});
  266.     $buffersize = $howmuch unless defined($buffersize);
  267.     return InternetReadFile($self->{'handle'}, ($howmuch<$buffersize) ? $howmuch 
  268.                                                                       : $buffersize);
  269. }
  270.  
  271.  
  272. #===================
  273. sub ReadEntireFile {
  274. #===================
  275.     my($handle) = @_;
  276.     my $content    = "";
  277.     my $buffersize = 16000;
  278.     my $howmuch    = 0;
  279.     my $buffer     = "";
  280.  
  281.     $handle = $handle->{'handle'} if defined($handle) and ref($handle);
  282.  
  283.     $howmuch = InternetQueryDataAvailable($handle);
  284.     # print "\nReadEntireFile: $howmuch bytes to read...\n";
  285.   
  286.     while($howmuch>0) {
  287.         $buffer = InternetReadFile($handle, ($howmuch<$buffersize) ? $howmuch 
  288.                                                                    : $buffersize);
  289.         # print "\nReadEntireFile: ", length($buffer), " bytes read...\n";
  290.     
  291.         if(!defined($buffer)) {
  292.             return undef;
  293.         } else {
  294.             $content .= $buffer;
  295.         }
  296.         $howmuch = InternetQueryDataAvailable($handle);
  297.         # print "\nReadEntireFile: still $howmuch bytes to read...\n";
  298.     
  299.     }
  300.     return $content;
  301. }
  302.  
  303.  
  304. #=============
  305. sub FetchURL {
  306. #=============
  307.     # (OpenURL+Read+Close)...
  308.     my($self, $URL) = @_;
  309.     return undef unless ref($self);
  310.  
  311.     my $newhandle = InternetOpenUrl($self->{'handle'}, $URL, "", 0, 0, 0);
  312.     if(!$newhandle) {
  313.         $self->{'Error'} = "Cannot open URL.";
  314.         return undef;
  315.     } else {
  316.         my $content = ReadEntireFile($newhandle);
  317.         InternetCloseHandle($newhandle);
  318.         return $content;
  319.     }
  320. }
  321.  
  322.  
  323. #================
  324. sub Connections {
  325. #================
  326.     my($self) = @_;
  327.     return undef unless ref($self);
  328.  
  329.     return $self->{'connections'} if $self->{'Type'} eq "Internet";
  330.     return undef;
  331. }
  332.  
  333.  
  334. #================
  335. sub GetResponse {
  336. #================
  337.     my($num, $text) = InternetGetLastResponseInfo();
  338.     return $text;
  339. }
  340.  
  341. #===========
  342. sub Option {
  343. #===========
  344.     my($self, $option, $value) = @_;
  345.     return undef unless ref($self);
  346.  
  347.     my $retval = 0;
  348.  
  349.     $option = constant("INTERNET_OPTION_USER_AGENT", 0) unless defined($option);
  350.   
  351.     if(!defined($value)) {
  352.         $retval = InternetQueryOption($self->{'handle'}, $option);
  353.     } else {
  354.         $retval = InternetSetOption($self->{'handle'}, $option, $value);
  355.     }
  356.     return $retval;
  357. }
  358.  
  359.  
  360. #==============
  361. sub UserAgent {
  362. #==============
  363.     my($self, $value) = @_;
  364.     return undef unless ref($self);
  365.  
  366.     return Option($self, constant("INTERNET_OPTION_USER_AGENT", 0), $value);
  367. }
  368.  
  369.  
  370. #=============
  371. sub Username {
  372. #=============
  373.     my($self, $value) = @_;
  374.     return undef unless ref($self);
  375.   
  376.     if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
  377.         $self->{'Error'} = "Username() only on FTP or HTTP sessions.";
  378.         return undef;
  379.     }
  380.  
  381.     return Option($self, constant("INTERNET_OPTION_USERNAME", 0), $value);
  382. }
  383.  
  384.  
  385. #=============
  386. sub Password {
  387. #=============
  388.     my($self, $value)=@_;
  389.     return undef unless ref($self);
  390.  
  391.     if($self->{'Type'} ne "HTTP" and $self->{'Type'} ne "FTP") {
  392.         $self->{'Error'} = "Password() only on FTP or HTTP sessions.";
  393.         return undef;
  394.     }
  395.  
  396.     return Option($self, constant("INTERNET_OPTION_PASSWORD", 0), $value);
  397. }
  398.  
  399.  
  400. #===================
  401. sub ConnectTimeout {
  402. #===================
  403.     my($self, $value) = @_;
  404.     return undef unless ref($self);
  405.  
  406.     return Option($self, constant("INTERNET_OPTION_CONNECT_TIMEOUT", 0), $value);
  407. }
  408.  
  409.  
  410. #===================
  411. sub ConnectRetries {
  412. #===================
  413.     my($self, $value) = @_;
  414.     return undef unless ref($self);
  415.  
  416.     return Option($self, constant("INTERNET_OPTION_CONNECT_RETRIES", 0), $value);
  417. }
  418.  
  419.  
  420. #===================
  421. sub ConnectBackoff {
  422. #===================
  423.     my($self,$value)=@_;
  424.     return undef unless ref($self);
  425.  
  426.     return Option($self, constant("INTERNET_OPTION_CONNECT_BACKOFF", 0), $value);
  427. }
  428.  
  429.  
  430. #====================
  431. sub DataSendTimeout {
  432. #====================
  433.     my($self,$value) = @_;
  434.     return undef unless ref($self);
  435.  
  436.     return Option($self, constant("INTERNET_OPTION_DATA_SEND_TIMEOUT", 0), $value);
  437. }
  438.  
  439.  
  440. #=======================
  441. sub DataReceiveTimeout {
  442. #=======================
  443.     my($self, $value) = @_;
  444.     return undef unless ref($self);
  445.  
  446.     return Option($self, constant("INTERNET_OPTION_DATA_RECEIVE_TIMEOUT", 0), $value);
  447. }
  448.  
  449.  
  450. #==========================
  451. sub ControlReceiveTimeout {
  452. #==========================
  453.     my($self, $value) = @_;
  454.     return undef unless ref($self);
  455.  
  456.     return Option($self, constant("INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT", 0), $value);
  457. }
  458.  
  459.  
  460. #=======================
  461. sub ControlSendTimeout {
  462. #=======================
  463.     my($self, $value) = @_;
  464.     return undef unless ref($self);
  465.  
  466.     return Option($self, constant("INTERNET_OPTION_CONTROL_SEND_TIMEOUT", 0), $value);
  467. }
  468.  
  469.  
  470. #================
  471. sub QueryOption {
  472. #================
  473.     my($self, $option) = @_;
  474.     return undef unless ref($self);
  475.  
  476.     return InternetQueryOption($self->{'handle'}, $option);
  477. }
  478.  
  479.  
  480. #==============
  481. sub SetOption {
  482. #==============
  483.     my($self, $option, $value) = @_;
  484.     return undef unless ref($self);
  485.  
  486.     return InternetSetOption($self->{'handle'}, $option, $value);
  487. }
  488.  
  489.  
  490. #=============
  491. sub CrackURL {
  492. #=============
  493.     my($self, $URL, $flags) = @_;
  494.     return undef unless ref($self);
  495.  
  496.     $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  497.   
  498.     my @newurl = InternetCrackUrl($URL, $flags);
  499.   
  500.     if(!defined($newurl[0])) {
  501.         $self->{'Error'} = "Cannot crack URL.";
  502.         return undef;
  503.     } else {
  504.         return @newurl;
  505.     }
  506. }
  507.  
  508.  
  509. #==============
  510. sub CreateURL {
  511. #==============
  512.     my($self, $scheme, $hostname, $port, 
  513.        $username, $password, 
  514.        $path, $extrainfo, $flags) = @_;
  515.     return undef unless ref($self);
  516.  
  517.     if(ref($scheme) and ref($scheme) eq "HASH") {
  518.         $flags       = $hostname;
  519.         $hostname    = $scheme->{'hostname'};
  520.         $port        = $scheme->{'port'};
  521.         $username    = $scheme->{'username'};
  522.         $password    = $scheme->{'password'};
  523.         $path        = $scheme->{'path'};
  524.         $extrainfo   = $scheme->{'extrainfo'};
  525.         my $myscheme = $scheme->{'scheme'};
  526.         undef $scheme;
  527.         $scheme      = $myscheme;
  528.     }
  529.  
  530.     $hostname  = ""                    unless defined($hostname);
  531.     $port      = 0                     unless defined($port);
  532.     $username  = ""                    unless defined($username);
  533.     $password  = ""                    unless defined($password);
  534.     $path      = ""                    unless defined($path);
  535.     $extrainfo = ""                    unless defined($extrainfo);
  536.     $flags = constant("ICU_ESCAPE", 0) unless defined($flags);
  537.   
  538.     my $newurl = InternetCreateUrl($scheme, $hostname, $port,
  539.                                    $username, $password,
  540.                                    $path, $extrainfo, $flags);
  541.     if(!defined($newurl)) {
  542.         $self->{'Error'} = "Cannot create URL.";
  543.         return undef;
  544.     } else {
  545.         return $newurl;
  546.     }
  547. }
  548.  
  549.  
  550. #====================
  551. sub CanonicalizeURL {
  552. #====================
  553.     my($self, $URL, $flags) = @_;
  554.     return undef unless ref($self);
  555.   
  556.     my $newurl = InternetCanonicalizeUrl($URL, $flags);
  557.     if(!defined($newurl)) {
  558.         $self->{'Error'} = "Cannot canonicalize URL.";
  559.         return undef;
  560.     } else {
  561.         return $newurl;
  562.     }
  563. }
  564.  
  565.  
  566. #===============
  567. sub CombineURL {
  568. #===============
  569.     my($self, $baseURL, $relativeURL, $flags) = @_;
  570.     return undef unless ref($self);
  571.   
  572.     my $newurl = InternetCombineUrl($baseURL, $relativeURL, $flags);
  573.     if(!defined($newurl)) {
  574.         $self->{'Error'} = "Cannot combine URL(s).";
  575.         return undef;
  576.     } else {
  577.         return $newurl;
  578.     }
  579. }
  580.  
  581.  
  582. #======================
  583. sub SetStatusCallback {
  584. #======================
  585.     my($self) = @_;
  586.     return undef unless ref($self);
  587.   
  588.     my $callback = InternetSetStatusCallback($self->{'handle'});
  589.     print "callback=$callback, constant=",constant("INTERNET_INVALID_STATUS_CALLBACK", 0), "\n";
  590.     if($callback == constant("INTERNET_INVALID_STATUS_CALLBACK", 0)) {
  591.         return undef;
  592.     } else {
  593.         return $callback;
  594.     }
  595. }
  596.  
  597.  
  598. #======================
  599. sub GetStatusCallback {
  600. #======================
  601.     my($self, $context) = @_;
  602.     $context = $self if not defined $context;
  603.     return($callback_code{$context}, $callback_info{$context});
  604. }
  605.  
  606.  
  607. #==========
  608. sub Error {
  609. #==========
  610.     my($self) = @_;
  611.     return undef unless ref($self);
  612.   
  613.     my $errtext = "";
  614.     my $tmp     = "";
  615.     my $errnum  = Win32::GetLastError();
  616.  
  617.     if($errnum < 12000) {
  618.         $errtext =  Win32::FormatMessage($errnum);
  619.         $errtext =~ s/[\r\n]//g;
  620.     } elsif($errnum == 12003) {
  621.         ($tmp, $errtext) = InternetGetLastResponseInfo();
  622.         chomp $errtext;
  623.         1 while($errtext =~ s/(.*)\n//); # the last line should be significative... 
  624.                                          # otherwise call GetResponse() to get it whole
  625.     } elsif($errnum >= 12000) {
  626.         $errtext = FormatMessage($errnum);
  627.         $errtext =~ s/[\r\n]//g;        
  628.     } else {
  629.         $errtext="Error";
  630.     }
  631.     if($errnum == 0 and defined($self->{'Error'})) { 
  632.         if($self->{'Error'} == -2) {
  633.             $errnum  = -2;
  634.             $errtext = "Asynchronous operations not available.";
  635.         } else {
  636.             $errnum  = -1;
  637.             $errtext = $self->{'Error'};
  638.         }
  639.     }
  640.     return (wantarray)? ($errnum, $errtext) : "\[".$errnum."\] ".$errtext;
  641. }
  642.  
  643.  
  644. #============
  645. sub Version {
  646. #============
  647.     my $dll =  InternetDllVersion();
  648.        $dll =~ s/\0//g;
  649.     return (wantarray)? ($Win32::Internet::VERSION,    $dll) 
  650.                       :  $Win32::Internet::VERSION."/".$dll;
  651. }
  652.  
  653.  
  654. #==========
  655. sub Close {
  656. #==========
  657.     my($self, $handle) = @_;
  658.     if(!defined($handle)) {
  659.         return undef unless ref($self);
  660.         $handle = $self->{'handle'};
  661.     }
  662.     InternetCloseHandle($handle);
  663. }
  664.  
  665.  
  666.  
  667. #######################################################################
  668. # FTP CLASS METHODS
  669. #
  670.  
  671. #======== ### FTP CONSTRUCTOR
  672. sub FTP {
  673. #========
  674.     my($self, $new, $server, $username, $password, $port, $pasv, $context) = @_;    
  675.     return undef unless ref($self);
  676.  
  677.     if(ref($server) and ref($server) eq "HASH") {
  678.         $port        = $server->{'port'};
  679.         $username    = $server->{'username'};
  680.         $password    = $password->{'host'};
  681.         my $myserver = $server->{'server'};
  682.         $pasv        = $server->{'pasv'};
  683.         $context     = $server->{'context'};
  684.         undef $server;
  685.         $server      = $myserver;
  686.     }
  687.   
  688.     $server   = ""          unless defined($server);
  689.     $username = "anonymous" unless defined($username);
  690.     $password = ""          unless defined($password);
  691.     $port     = 21          unless defined($port);
  692.     $context  = 0           unless defined($context);
  693.  
  694.     if(defined($pasv)) {
  695.         $pasv=constant("INTERNET_CONNECT_FLAG_PASSIVE",0) if $pasv ne 0;
  696.     } else {  
  697.         $pasv=$self->{'pasv'};
  698.     }
  699.   
  700.     my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
  701.                                     $username, $password,
  702.                                     constant("INTERNET_SERVICE_FTP", 0),
  703.                                     $pasv, $context);
  704.     if($newhandle) {
  705.         $self->{'connections'}++;
  706.         $_[1] = _new($newhandle);
  707.         $_[1]->{'Type'}     = "FTP";
  708.         $_[1]->{'Mode'}     = "bin";
  709.         $_[1]->{'pasv'}     = $pasv;
  710.         $_[1]->{'username'} = $username;
  711.         $_[1]->{'password'} = $password;
  712.         $_[1]->{'server'}   = $server;
  713.         return $newhandle;
  714.     } else {
  715.         return undef;
  716.     }
  717. }
  718.  
  719. #========
  720. sub Pwd {
  721. #========
  722.     my($self) = @_;
  723.     return undef unless ref($self);
  724.  
  725.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  726.         $self->{'Error'} = "Pwd() only on FTP sessions.";
  727.         return undef;
  728.     }
  729.   
  730.     return FtpGetCurrentDirectory($self->{'handle'});
  731. }
  732.  
  733.  
  734. #=======
  735. sub Cd {
  736. #=======
  737.     my($self, $path) = @_;
  738.     return undef unless ref($self);
  739.  
  740.     if($self->{'Type'} ne "FTP" || !defined($self->{'handle'})) {
  741.         $self->{'Error'} = "Cd() only on FTP sessions.";
  742.         return undef;
  743.     }
  744.   
  745.     my $retval = FtpSetCurrentDirectory($self->{'handle'}, $path);
  746.     if(!defined($retval)) {
  747.         return undef;
  748.     } else {
  749.         return $path;
  750.     }
  751. }
  752. #====================
  753. sub Cwd   { Cd(@_); }
  754. sub Chdir { Cd(@_); }
  755. #====================
  756.  
  757.  
  758. #==========
  759. sub Mkdir {
  760. #==========
  761.     my($self, $path) = @_;
  762.     return undef unless ref($self);
  763.  
  764.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  765.         $self->{'Error'} = "Mkdir() only on FTP sessions.";
  766.         return undef;
  767.     }
  768.   
  769.     my $retval = FtpCreateDirectory($self->{'handle'}, $path);
  770.     $self->{'Error'} = "Can't create directory." unless defined($retval);
  771.     return $retval;
  772. }
  773. #====================
  774. sub Md { Mkdir(@_); }
  775. #====================
  776.  
  777.  
  778. #=========
  779. sub Mode {
  780. #=========
  781.     my($self, $value) = @_;
  782.     return undef unless ref($self);
  783.  
  784.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  785.         $self->{'Error'} = "Mode() only on FTP sessions.";
  786.         return undef;
  787.     }
  788.   
  789.     if(!defined($value)) {
  790.         return $self->{'Mode'};
  791.     } else {
  792.         my $modesub = ($value =~ /^a/i) ? "Ascii" : "Binary";
  793.         $self->$modesub($_[0]);
  794.     }
  795.     return $self->{'Mode'};
  796. }
  797.  
  798.  
  799. #==========
  800. sub Rmdir {
  801. #==========
  802.     my($self, $path) = @_;
  803.     return undef unless ref($self);
  804.  
  805.     if($self->{'Type'} ne "FTP" or !defined($self->{'handle'})) {
  806.         $self->{'Error'} = "Rmdir() only on FTP sessions.";
  807.         return undef;
  808.     }
  809.     my $retval = FtpRemoveDirectory($self->{'handle'}, $path);
  810.     $self->{'Error'} = "Can't remove directory." unless defined($retval);
  811.     return $retval;
  812. }
  813. #====================
  814. sub Rd { Rmdir(@_); }
  815. #====================
  816.  
  817.  
  818. #=========
  819. sub Pasv {
  820. #=========
  821.     my($self, $value) = @_;
  822.     return undef unless ref($self);
  823.  
  824.     if(defined($value) and $self->{'Type'} eq "Internet") {
  825.         if($value == 0) {
  826.             $self->{'pasv'} = 0;
  827.         } else {
  828.             $self->{'pasv'} = 1;
  829.         }
  830.     }
  831.     return $self->{'pasv'};
  832. }
  833.  
  834. #=========
  835. sub List {
  836. #=========
  837.     my($self, $pattern, $retmode) = @_;
  838.     return undef unless ref($self);
  839.  
  840.     my $retval = "";
  841.     my $size   = ""; 
  842.     my $attr   = ""; 
  843.     my $ctime  = ""; 
  844.     my $atime  = ""; 
  845.     my $mtime  = "";
  846.     my $csec = 0; my $cmin = 0; my $chou = 0; my $cday = 0; my $cmon = 0; my $cyea = 0;
  847.     my $asec = 0; my $amin = 0; my $ahou = 0; my $aday = 0; my $amon = 0; my $ayea = 0;
  848.     my $msec = 0; my $mmin = 0; my $mhou = 0; my $mday = 0; my $mmon = 0; my $myea = 0;
  849.     my $newhandle = 0;
  850.     my $nextfile  = 1;
  851.     my @results   = ();
  852.     my ($filename, $altname, $file);
  853.   
  854.     if($self->{'Type'} ne "FTP") {
  855.         $self->{'Error'} = "List() only on FTP sessions.";
  856.         return undef;
  857.     }
  858.   
  859.     $pattern = "" unless defined($pattern);
  860.     $retmode = 1  unless defined($retmode);
  861.  
  862.     if($retmode == 2) {
  863.   
  864.         ( $newhandle,$filename, $altname, $size, $attr,         
  865.           $csec, $cmin, $chou, $cday, $cmon, $cyea,
  866.           $asec, $amin, $ahou, $aday, $amon, $ayea,
  867.           $msec, $mmin, $mhou, $mday, $mmon, $myea
  868.         ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  869.     
  870.         if(!$newhandle) {
  871.             $self->{'Error'} = "Can't read FTP directory.";
  872.             return undef;
  873.         } else {
  874.     
  875.             while($nextfile) {
  876.                 $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
  877.                 $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
  878.                 $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
  879.                 push(@results, $filename, $altname, $size, $attr, $ctime, $atime, $mtime);
  880.         
  881.                 ( $nextfile, $filename, $altname, $size, $attr,
  882.                   $csec, $cmin, $chou, $cday, $cmon, $cyea,
  883.                   $asec, $amin, $ahou, $aday, $amon, $ayea,
  884.                   $msec, $mmin, $mhou, $mday, $mmon, $myea
  885.                 ) = InternetFindNextFile($newhandle);      
  886.         
  887.             }
  888.             InternetCloseHandle($newhandle);
  889.             return @results;
  890.       
  891.         }
  892.     
  893.     } elsif($retmode == 3) {
  894.   
  895.         ( $newhandle,$filename, $altname, $size, $attr,
  896.           $csec, $cmin, $chou, $cday, $cmon, $cyea,
  897.           $asec, $amin, $ahou, $aday, $amon, $ayea,
  898.           $msec, $mmin, $mhou, $mday, $mmon, $myea
  899.         ) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  900.     
  901.         if(!$newhandle) {
  902.             $self->{'Error'} = "Can't read FTP directory.";
  903.             return undef;
  904.        
  905.         } else {
  906.      
  907.             while($nextfile) {
  908.                 $ctime = join(",", ($csec, $cmin, $chou, $cday, $cmon, $cyea));
  909.                 $atime = join(",", ($asec, $amin, $ahou, $aday, $amon, $ayea));
  910.                 $mtime = join(",", ($msec, $mmin, $mhou, $mday, $mmon, $myea));
  911.                 $file = { "name"     => $filename,
  912.                           "altname"  => $altname,
  913.                           "size"     => $size,
  914.                           "attr"     => $attr,
  915.                           "ctime"    => $ctime,
  916.                           "atime"    => $atime,
  917.                           "mtime"    => $mtime,
  918.                 };
  919.                 push(@results, $file);
  920.          
  921.                 ( $nextfile, $filename, $altname, $size, $attr,
  922.                   $csec, $cmin, $chou, $cday, $cmon, $cyea,
  923.                   $asec, $amin, $ahou, $aday, $amon, $ayea,
  924.                   $msec, $mmin, $mhou, $mday, $mmon, $myea
  925.                 ) = InternetFindNextFile($newhandle);
  926.          
  927.             }
  928.             InternetCloseHandle($newhandle);
  929.             return @results;
  930.         }
  931.     
  932.     } else {
  933.     
  934.         ($newhandle, $filename) = FtpFindFirstFile($self->{'handle'}, $pattern, 0, 0);
  935.     
  936.         if(!$newhandle) {
  937.             $self->{'Error'} = "Can't read FTP directory.";
  938.             return undef;
  939.       
  940.         } else {
  941.     
  942.             while($nextfile) {
  943.                 push(@results, $filename);
  944.         
  945.                 ($nextfile, $filename) = InternetFindNextFile($newhandle);  
  946.                 # print "List.no more files\n" if !$nextfile;
  947.         
  948.             }
  949.             InternetCloseHandle($newhandle);
  950.             return @results;
  951.         }
  952.     }
  953. }
  954. #====================
  955. sub Ls  { List(@_); }
  956. sub Dir { List(@_); }
  957. #====================
  958.  
  959.  
  960. #=================
  961. sub FileAttrInfo {
  962. #=================
  963.     my($self,$attr) = @_;
  964.     my @attrinfo = ();
  965.     push(@attrinfo, "READONLY")   if $attr & 1;
  966.     push(@attrinfo, "HIDDEN")     if $attr & 2;
  967.     push(@attrinfo, "SYSTEM")     if $attr & 4;
  968.     push(@attrinfo, "DIRECTORY")  if $attr & 16;
  969.     push(@attrinfo, "ARCHIVE")    if $attr & 32;
  970.     push(@attrinfo, "NORMAL")     if $attr & 128;
  971.     push(@attrinfo, "TEMPORARY")  if $attr & 256;
  972.     push(@attrinfo, "COMPRESSED") if $attr & 2048;
  973.     return (wantarray)? @attrinfo : join(" ", @attrinfo);
  974. }
  975.  
  976.  
  977. #===========
  978. sub Binary {
  979. #===========
  980.     my($self) = @_;
  981.     return undef unless ref($self);
  982.  
  983.     if($self->{'Type'} ne "FTP") {
  984.         $self->{'Error'} = "Binary() only on FTP sessions.";
  985.         return undef;
  986.     }
  987.     $self->{'Mode'} = "bin";
  988.     return undef;
  989. }
  990. #======================
  991. sub Bin { Binary(@_); }
  992. #======================
  993.  
  994.  
  995. #==========
  996. sub Ascii {
  997. #==========
  998.     my($self) = @_;
  999.     return undef unless ref($self);
  1000.  
  1001.     if($self->{'Type'} ne "FTP") {
  1002.         $self->{'Error'} = "Ascii() only on FTP sessions.";
  1003.         return undef;
  1004.     }
  1005.     $self->{'Mode'} = "asc";
  1006.     return undef;
  1007. }
  1008. #=====================
  1009. sub Asc { Ascii(@_); }
  1010. #=====================
  1011.  
  1012.  
  1013. #========
  1014. sub Get {
  1015. #========
  1016.     my($self, $remote, $local, $overwrite, $flags, $context) = @_;
  1017.     return undef unless ref($self);
  1018.  
  1019.     if($self->{'Type'} ne "FTP") {
  1020.         $self->{'Error'} = "Get() only on FTP sessions.";
  1021.         return undef;
  1022.     }
  1023.     my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
  1024.  
  1025.     $remote    = ""      unless defined($remote);
  1026.     $local     = $remote unless defined($local);
  1027.     $overwrite = 0       unless defined($overwrite);
  1028.     $flags     = 0       unless defined($flags);
  1029.     $context   = 0       unless defined($context);
  1030.   
  1031.     my $retval = FtpGetFile($self->{'handle'},
  1032.                             $remote,
  1033.                             $local,
  1034.                             $overwrite,
  1035.                             $flags,
  1036.                             $mode,
  1037.                             $context);
  1038.     $self->{'Error'} = "Can't get file." unless defined($retval);
  1039.     return $retval;
  1040. }
  1041.  
  1042.  
  1043. #===========
  1044. sub Rename {
  1045. #===========
  1046.     my($self, $oldname, $newname) = @_;
  1047.     return undef unless ref($self);
  1048.  
  1049.     if($self->{'Type'} ne "FTP") {
  1050.         $self->{'Error'} = "Rename() only on FTP sessions.";
  1051.         return undef;
  1052.     }
  1053.  
  1054.     my $retval = FtpRenameFile($self->{'handle'}, $oldname, $newname);
  1055.     $self->{'Error'} = "Can't rename file." unless defined($retval);
  1056.     return $retval;
  1057. }
  1058. #======================
  1059. sub Ren { Rename(@_); }
  1060. #======================
  1061.  
  1062.  
  1063. #===========
  1064. sub Delete {
  1065. #===========
  1066.     my($self, $filename) = @_;
  1067.     return undef unless ref($self);
  1068.  
  1069.     if($self->{'Type'} ne "FTP") {
  1070.         $self->{'Error'} = "Delete() only on FTP sessions.";
  1071.         return undef;
  1072.     }
  1073.     my $retval = FtpDeleteFile($self->{'handle'}, $filename);
  1074.     $self->{'Error'} = "Can't delete file." unless defined($retval);
  1075.     return $retval;
  1076. }
  1077. #======================
  1078. sub Del { Delete(@_); }
  1079. #======================
  1080.  
  1081.  
  1082. #========
  1083. sub Put {
  1084. #========
  1085.     my($self, $local, $remote, $context) = @_;
  1086.     return undef unless ref($self);
  1087.  
  1088.     if($self->{'Type'} ne "FTP") {
  1089.         $self->{'Error'} = "Put() only on FTP sessions.";
  1090.         return undef;
  1091.     }
  1092.     my $mode = ($self->{'Mode'} eq "asc" ? 1 : 2);
  1093.  
  1094.     $context = 0 unless defined($context);
  1095.   
  1096.     my $retval = FtpPutFile($self->{'handle'}, $local, $remote, $mode, $context);
  1097.     $self->{'Error'} = "Can't put file." unless defined($retval);
  1098.     return $retval;
  1099. }
  1100.  
  1101.  
  1102. #######################################################################
  1103. # HTTP CLASS METHODS
  1104. #
  1105.  
  1106. #========= ### HTTP CONSTRUCTOR
  1107. sub HTTP {
  1108. #=========
  1109.     my($self, $new, $server, $username, $password, $port, $flags, $context) = @_;    
  1110.     return undef unless ref($self);
  1111.  
  1112.     if(ref($server) and ref($server) eq "HASH") {
  1113.         my $myserver = $server->{'server'};
  1114.         $username    = $server->{'username'};
  1115.         $password    = $password->{'host'};
  1116.         $port        = $server->{'port'};    
  1117.         $flags       = $server->{'flags'};
  1118.         $context     = $server->{'context'};
  1119.         undef $server;
  1120.         $server      = $myserver;
  1121.     }
  1122.  
  1123.     $server   = ""          unless defined($server);
  1124.     $username = "anonymous" unless defined($username);
  1125.     $password = ""          unless defined($username);
  1126.     $port     = 80          unless defined($port);
  1127.     $flags    = 0           unless defined($flags);
  1128.     $context  = 0           unless defined($context);
  1129.   
  1130.     my $newhandle = InternetConnect($self->{'handle'}, $server, $port,
  1131.                                     $username, $password,
  1132.                                     constant("INTERNET_SERVICE_HTTP", 0),
  1133.                                     $flags, $context);
  1134.     if($newhandle) {
  1135.         $self->{'connections'}++;
  1136.         $_[1] = _new($newhandle);
  1137.         $_[1]->{'Type'}     = "HTTP";
  1138.         $_[1]->{'username'} = $username;
  1139.         $_[1]->{'password'} = $password;
  1140.         $_[1]->{'server'}   = $server;
  1141.         $_[1]->{'accept'}   = "text/*\0image/gif\0image/jpeg";
  1142.         return $newhandle;
  1143.     } else {
  1144.         return undef;
  1145.     }
  1146. }
  1147.  
  1148.  
  1149. #================
  1150. sub OpenRequest {
  1151. #================
  1152.     # alternatively to Request:
  1153.     # it creates a new HTTP_Request object
  1154.     # you can act upon it with AddHeader, SendRequest, ReadFile, QueryInfo, Close, ...
  1155.  
  1156.     my($self, $new, $path, $method, $version, $referer, $accept, $flags, $context) = @_;
  1157.     return undef unless ref($self);
  1158.  
  1159.     if($self->{'Type'} ne "HTTP") {
  1160.         $self->{'Error'} = "OpenRequest() only on HTTP sessions.";
  1161.         return undef;
  1162.     }
  1163.  
  1164.     if(ref($path) and ref($path) eq "HASH") {
  1165.         $method    = $path->{'method'};
  1166.         $version   = $path->{'version'};
  1167.         $referer   = $path->{'referer'};
  1168.         $accept    = $path->{'accept'};
  1169.         $flags     = $path->{'flags'};
  1170.         $context   = $path->{'context'};
  1171.         my $mypath = $path->{'path'};
  1172.         undef $path;
  1173.         $path      = $mypath;
  1174.     }
  1175.  
  1176.     $method  = "GET"             unless defined($method);
  1177.     $path    = "/"               unless defined($path);
  1178.     $version = "HTTP/1.0"        unless defined($version); 
  1179.     $referer = ""                unless defined($referer);
  1180.     $accept  = $self->{'accept'} unless defined($accept);
  1181.     $flags   = 0                 unless defined($flags);
  1182.     $context = 0                 unless defined($context);
  1183.   
  1184.     $path = "/".$path if substr($path,0,1) ne "/";  
  1185.   
  1186.     my $newhandle = HttpOpenRequest($self->{'handle'},
  1187.                                     $method,
  1188.                                     $path,
  1189.                                     $version,
  1190.                                     $referer,
  1191.                                     $accept,
  1192.                                     $flags,
  1193.                                     $context);
  1194.     if($newhandle) {
  1195.         $_[1] = _new($newhandle);
  1196.         $_[1]->{'Type'}    = "HTTP_Request";
  1197.         $_[1]->{'method'}  = $method;
  1198.         $_[1]->{'request'} = $path;
  1199.         $_[1]->{'accept'}  = $accept;
  1200.         return $newhandle;
  1201.     } else {
  1202.         return undef;
  1203.     }
  1204. }
  1205.  
  1206. #================
  1207. sub SendRequest {
  1208. #================
  1209.     my($self, $postdata) = @_;
  1210.     return undef unless ref($self);
  1211.  
  1212.     if($self->{'Type'} ne "HTTP_Request") {
  1213.         $self->{'Error'} = "SendRequest() only on HTTP requests.";
  1214.         return undef;
  1215.     }
  1216.   
  1217.     $postdata = "" unless defined($postdata);
  1218.  
  1219.     return HttpSendRequest($self->{'handle'}, "", $postdata);
  1220. }
  1221.  
  1222.  
  1223. #==============
  1224. sub AddHeader {
  1225. #==============
  1226.     my($self, $header, $flags) = @_;
  1227.     return undef unless ref($self);
  1228.   
  1229.     if($self->{'Type'} ne "HTTP_Request") {
  1230.         $self->{'Error'} = "AddHeader() only on HTTP requests.";
  1231.         return undef;
  1232.     }
  1233.   
  1234.     $flags = constant("HTTP_ADDREQ_FLAG_ADD", 0) if (!defined($flags) or $flags == 0);
  1235.  
  1236.     return HttpAddRequestHeaders($self->{'handle'}, $header, $flags);
  1237. }
  1238.  
  1239.  
  1240. #==============
  1241. sub QueryInfo {
  1242. #==============
  1243.     my($self, $header, $flags) = @_;
  1244.     return undef unless ref($self);
  1245.  
  1246.     if($self->{'Type'} ne "HTTP_Request") {
  1247.         $self->{'Error'}="QueryInfo() only on HTTP requests.";
  1248.         return undef;
  1249.     }
  1250.   
  1251.     $flags = constant("HTTP_QUERY_CUSTOM", 0) if (!defined($flags) and defined($header));
  1252.     my @queryresult = HttpQueryInfo($self->{'handle'}, $flags, $header);
  1253.     return (wantarray)? @queryresult : join(" ", @queryresult);
  1254. }
  1255.  
  1256.  
  1257. #============
  1258. sub Request {
  1259. #============
  1260.     # HttpOpenRequest+HttpAddHeaders+HttpSendRequest+InternetReadFile+HttpQueryInfo
  1261.     my($self, $path, $method, $version, $referer, $accept, $flags, $postdata) = @_;
  1262.     return undef unless ref($self);
  1263.  
  1264.     if($self->{'Type'} ne "HTTP") {
  1265.         $self->{'Error'} = "Request() only on HTTP sessions.";
  1266.         return undef;
  1267.     }
  1268.  
  1269.     if(ref($path) and ref($path) eq "HASH") {
  1270.         $method    = $path->{'method'};
  1271.         $version   = $path->{'version'};
  1272.         $referer   = $path->{'referer'};
  1273.         $accept    = $path->{'accept'};
  1274.         $flags     = $path->{'flags'};
  1275.         $postdata  = $path->{'postdata'};
  1276.         my $mypath = $path->{'path'};
  1277.         undef $path;
  1278.         $path      = $mypath;
  1279.     }
  1280.  
  1281.     my $content     = "";
  1282.     my $result      = "";
  1283.     my @queryresult = ();
  1284.     my $statuscode  = "";
  1285.     my $headers     = "";
  1286.   
  1287.     $path     = "/"               unless defined($path);
  1288.     $method   = "GET"             unless defined($method);
  1289.     $version  = "HTTP/1.0"        unless defined($version); 
  1290.     $referer  = ""                unless defined($referer);
  1291.     $accept   = $self->{'accept'} unless defined($accept);
  1292.     $flags    = 0                 unless defined($flags);
  1293.     $postdata = ""                unless defined($postdata);
  1294.  
  1295.     $path = "/".$path if substr($path,0,1) ne "/";  
  1296.   
  1297.     my $newhandle = HttpOpenRequest($self->{'handle'},
  1298.                                     $method,
  1299.                                     $path,
  1300.                                     $version,
  1301.                                     $referer,
  1302.                                     $accept,
  1303.                                     0,
  1304.                                     $flags);
  1305.  
  1306.     if($newhandle) {
  1307.  
  1308.         $result = HttpSendRequest($newhandle, "", $postdata);
  1309.  
  1310.         if(defined($result)) {
  1311.             $statuscode = HttpQueryInfo($newhandle,
  1312.                                         constant("HTTP_QUERY_STATUS_CODE", 0), "");
  1313.             $headers = HttpQueryInfo($newhandle,
  1314.                                      constant("HTTP_QUERY_RAW_HEADERS_CRLF", 0), "");
  1315.             $content = ReadEntireFile($newhandle);
  1316.                
  1317.             InternetCloseHandle($newhandle);
  1318.       
  1319.             return($statuscode, $headers, $content);
  1320.         } else {
  1321.             return undef;
  1322.         }
  1323.     } else {
  1324.         return undef;
  1325.     }
  1326. }
  1327.  
  1328.  
  1329. #######################################################################
  1330. # END OF THE PUBLIC METHODS
  1331. #
  1332.  
  1333.  
  1334. #========= ### SUB-CLASSES CONSTRUCTOR
  1335. sub _new {
  1336. #=========
  1337.     my $self = {};
  1338.     if ($_[0]) {
  1339.         $self->{'handle'} = $_[0];
  1340.         bless $self;
  1341.     } else {
  1342.         undef($self);
  1343.     }
  1344.     $self;
  1345. }
  1346.  
  1347.  
  1348. #============ ### CLASS DESTRUCTOR
  1349. sub DESTROY {
  1350. #============
  1351.     my($self) = @_;
  1352.     # print "Closing handle $self->{'handle'}...\n";
  1353.     InternetCloseHandle($self->{'handle'});
  1354.     # [dada] rest in peace
  1355. }
  1356.  
  1357.  
  1358. #=============
  1359. sub callback {
  1360. #=============
  1361.     my($name, $status, $info) = @_;
  1362.     $callback_code{$name} = $status;
  1363.     $callback_info{$name} = $info;
  1364. }
  1365.  
  1366. #######################################################################
  1367. # dynamically load in the Internet.pll module.
  1368. #
  1369.  
  1370. bootstrap Win32::Internet;
  1371.  
  1372. # Preloaded methods go here.
  1373.  
  1374. #Currently Autoloading is not implemented in Perl for win32
  1375. # Autoload methods go after __END__, and are processed by the autosplit program.
  1376.  
  1377. 1;
  1378. __END__
  1379.  
  1380.